home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / REALFT.DEM < prev    next >
Text File  |  1991-05-01  |  1KB  |  64 lines
  1. PROGRAM d12r3(input,output);
  2. (* driver for routine REALFT *)
  3. LABEL 1,99;
  4. CONST
  5.    eps=1.0e-3;
  6.    np=32;
  7.    np2=34;   (* np+2 *)
  8.    width=50.0;
  9.    pi=3.1415926;
  10. TYPE
  11.    gldarray = ARRAY [1..np2] OF real;
  12. VAR
  13.    big,per,scal,small : real;
  14.    i,j,n,nlim : integer;
  15.    data,size : gldarray;
  16.  
  17. (*$I MODFILE.PAS *)
  18. (*$I FOUR1.PAS *)
  19.  
  20. (*$I REALFT.PAS *)
  21.  
  22. BEGIN
  23.    n := np DIV 2;
  24. 1:   writeln('Period of sinusoid in channels (2-',np:2,')');
  25.    readln(per);
  26.    IF (per <= 0.0) THEN GOTO 99;
  27.    FOR i := 1 to np DO BEGIN
  28.       data[i] := cos(2.0*pi*(i-1)/per)
  29.    END;
  30.    realft(data,n,+1);
  31.    big := -1.0e10;
  32.    FOR i := 1 to n DO BEGIN
  33.       size[i] := sqrt(sqr(data[2*i-1])+sqr(data[2*i]));
  34.       IF (size[i] > big) THEN big := size[i]
  35.    END;
  36.    size[1] := data[1];
  37.    IF (size[1] > big) THEN big := size[1];
  38.    scal := width/big;
  39.    FOR i := 1 to n DO BEGIN
  40.       nlim := round(scal*size[i]+eps);
  41.       write(i:4,' ');
  42.       FOR j := 1 to nlim+1 DO write('*');
  43.       writeln
  44.    END;
  45.    writeln('press RETURN to continue ...');
  46.    readln;
  47.    realft(data,n,-1);
  48.    big := -1.0e10;
  49.    small := 1.0e10;
  50.    FOR i := 1 to np DO BEGIN
  51.       IF (data[i] < small) THEN small := data[i];
  52.       IF (data[i] > big) THEN big := data[i]
  53.    END;
  54.    scal := width/(big-small);
  55.    FOR i := 1 to np DO BEGIN
  56.       nlim := round(scal*(data[i]-small)+eps);
  57.       write(i:4,' ');
  58.       FOR j := 1 to nlim+1 DO write('*');
  59.       writeln
  60.    END;
  61.    GOTO 1;
  62. 99:
  63. END.
  64.